{$L- HISTOGRAM.LIST}

{
                                                  program by:  EDWARD J GRUNDLER
                                                  
     Changes made by reviewer:
       Reversed ranges in type SCREEN.
       Replaced PAGE(OUTPUT) by CLEARSCREEN.
       Replaced missing unit EDS_STUFF by REAL_INPUT.
                              ---Henry E. Baumgarten
}

PROGRAM HISTOGRAM;

USES {$U GRAPH.LIBRARY} SCREEN_STUFF, REAL_INPUT;

TYPE OPEN_OR_CLOSED = (OPEN,CLOSED);
     SCREEN = PACKED ARRAY[0..239,0..319] OF BOOLEAN;
VAR CH:CHAR;
    DATA:FILE OF
           RECORD
             NUMBER_OF_POINTS:INTEGER;
             DATA_POINT:ARRAY[1..255]OF REAL
           END; {OF RECORD}
    STARTED,OLD_DATA_AVAILABLE,NEW_DATA_USED:BOOLEAN;
    MIN,MAX,CLASS_WIDTH,LEFT_START:REAL;
    NUMB_OF_CLASSES,R:INTEGER;
    LEFT_END,RIGHT_END:OPEN_OR_CLOSED;
    CLASS:PACKED ARRAY[1..22] OF INTEGER;
    CLASS_LIMIT:ARRAY[0..22] OF REAL;

PROCEDURE DRAWLINE(VAR R:INTEGER; VAR S:SCREEN; RW,XS,YS,DX,DY,INK:INTEGER);
EXTERNAL;

PROCEDURE THROTTLE(TICKS:INTEGER);
EXTERNAL;

PROCEDURE DRAW_HISTOGRAM;
VAR I,Y_SCALE,XSTART,XSTOP,Y:INTEGER;
    S:SCREEN;
    RNG,LEFT,RIGHT,INC:REAL;
BEGIN {DRAW_HISTOGRAM}
  Y_SCALE:=0;
  FOR I:=1 TO NUMB_OF_CLASSES DO IF CLASS[I]>Y_SCALE THEN Y_SCALE:=CLASS[I];
  WHILE NOT (Y_SCALE IN [9,18,45,90,180,270]) DO Y_SCALE:=Y_SCALE+1;
  CLEARSCREEN;
  FILLCHAR(S,SIZEOF(S),CHR(0));
  UNITWRITE(3,S,63);
  GOTOXY(0,4);
  FOR I:=0 TO 9 DO
    BEGIN
      DRAWLINE(R,S,20,24,44+I*20,5,0,1);
      WRITELN(Y_SCALE DIV 9*(9-I):6);
      IF I<>9 THEN WRITELN
    END;
  RNG:=CLASS_WIDTH*NUMB_OF_CLASSES/18;
  LEFT:=LEFT_START-RNG;
  RIGHT:=LEFT+20*RNG;
  RNG:=RIGHT-LEFT;
  FOR I:=0 TO 10 DO
    BEGIN
      DRAWLINE(R,S,20,39+I*28,224,0,-5,1);
      GOTOXY(3+7*I,23);
      WRITE(LEFT+I*RNG/10:7:2)
    END;
  GOTOXY(0,0);
  INC:=RNG/280;
  DRAWLINE(R,S,20,24,43,0,181,1);
  DRAWLINE(R,S,20,24,224,295,0,1);
  FOR I:=1 TO NUMB_OF_CLASSES DO
    BEGIN
      XSTART:=319-ROUND((RIGHT-CLASS_LIMIT[I-1])/INC);
      XSTOP:=319-ROUND((RIGHT-CLASS_LIMIT[I])/INC);
      Y:=224-ROUND(CLASS[I]/Y_SCALE*180);
      DRAWLINE(R,S,20,XSTART,224,0,Y-224,1);
      DRAWLINE(R,S,20,XSTOP,224,0,Y-224,1);
      DRAWLINE(R,S,20,XSTART,Y,XSTOP-XSTART,0,1)
    END;
  WRITE('press RETURN to continue');
  READLN;
  UNITWRITE(3,S,7);
  CLEARSCREEN
END; {DRAW_HISTOGRAM}

PROCEDURE WRITE_FREQUENCY_DISTRIBUTION;
VAR I:INTEGER;
BEGIN {WRITE_FREQUENCY_DISTRIBUTION}
  CLEARSCREEN;
  FOR I:=1 TO NUMB_OF_CLASSES DO
    IF I=1 THEN
      WRITELN('CLASS',I:3,'  LEFT BOUNDRY = ',CLASS_LIMIT[I-1]:7:2,
              '  RIGHT BOUNDRY = ', CLASS_LIMIT[I]:7:2,'  NUMBER IN CLASS = ',
              CLASS[I]:3)
    ELSE WRITELN(I:8,CLASS_LIMIT[I-1]:24:2,CLASS_LIMIT[I]:25:2,CLASS[I]:23);
  WRITELN;
  WRITE('press RETURN to continue');
  READLN
END; {WRITE_FREQUENCY_DISTRIBUTION}

PROCEDURE SCAN_AND_ASSIGN_TO_CLASSES;
VAR I,J:INTEGER;
BEGIN {SCAN_AND_ASSIGN_TO_CLASSES}
  WRITELN;
  WRITE('SCANNING THE DATA');
  CLASS_LIMIT[0]:=LEFT_START;
  FOR I:=1 TO NUMB_OF_CLASSES DO
    BEGIN
      CLASS[I]:=0;
      CLASS_LIMIT[I]:=CLASS_LIMIT[I-1]+CLASS_WIDTH
    END;
  WITH DATA^ DO
    FOR I:=1 TO NUMBER_OF_POINTS DO
      BEGIN
        J:=0;
        WHILE J<NUMB_OF_CLASSES DO
          BEGIN
            J:=J+1;
            IF (J=1) AND (LEFT_END = OPEN) THEN
              IF DATA_POINT[I]<CLASS_LIMIT[J] THEN
                BEGIN
                  CLASS[J]:=CLASS[J]+1;
                  J:=NUMB_OF_CLASSES
                END
              ELSE
            ELSE
              IF (J=NUMB_OF_CLASSES) AND (RIGHT_END=OPEN) THEN
                IF DATA_POINT[I]>CLASS_LIMIT[J-1] THEN CLASS[J]:=CLASS[J]+1
                ELSE
              ELSE
                IF (DATA_POINT[I]>=CLASS_LIMIT[J-1]) AND
                   (DATA_POINT[I]<CLASS_LIMIT[J]) THEN
                  BEGIN
                    CLASS[J]:=CLASS[J]+1;
                    J:=NUMB_OF_CLASSES
                  END
          END
      END
END; {SCAN_AND_ASSIGN_TO_CLASSES}

PROCEDURE SET_UP_CLASSES;

  PROCEDURE COMPUTE_CLASS_WIDTH;
  BEGIN {COMPUTE_CLASS_WIDTH}
    CLASS_WIDTH:=(MAX-MIN)/NUMB_OF_CLASSES;
    IF CLASS_WIDTH=0 THEN CLASS_WIDTH:=0.8/NUMB_OF_CLASSES
    ELSE CLASS_WIDTH:=CLASS_WIDTH+CLASS_WIDTH*0.01/NUMB_OF_CLASSES;
    LEFT_START:=MIN-CLASS_WIDTH*0.005;
  END; {COMPUTE_CLASS_WIDTH}
  
  PROCEDURE WRITE_OUTPUT;
  BEGIN {WRITE_OUTPUT}
    CLEARSCREEN;
    WRITELN('NUMBER OF CLASSES = ',NUMB_OF_CLASSES);
    WRITELN('CLASS WIDTH = ',CLASS_WIDTH:8:6);
    WRITELN('LEFT BOUNDRY = ',LEFT_START:8:6);
    WRITE('LEFT BOUNDRY IS ');
    IF LEFT_END=CLOSED THEN WRITELN('CLOSED') ELSE WRITELN('OPEN');
    WRITE('RIGHT BOUNDRY IS ');
    IF RIGHT_END=CLOSED THEN WRITELN('CLOSED') ELSE WRITELN('OPEN');
    WRITELN
  END; {WRITE_OUTPUT}

  PROCEDURE ASK_ABOUT_CHANGES;
  VAR CH:CHAR;
  BEGIN {ASK_ABOUT_CHANGES}
    REPEAT
      WRITE('DO YOU WANT TO CHANGE ANY OF THIS DATA? ');
      REPEAT READ(KEYBOARD,CH) UNTIL CH IN ['Y','y','N','n'];
      IF CH IN ['Y','y'] THEN
        BEGIN
          WRITELN;
          WRITELN;
          WRITELN('N(umber of classes');
          WRITELN('W(idth');
          WRITELN('left B(oundry value');
          WRITELN('L(eft boundry condition');
          WRITELN('R(ight boundry condition');
          WRITELN;
          WRITELN('PLEASE SELECT BY PRESSING ONLY THE UPPER CASE LETTER! ');
          REPEAT
            READ(KEYBOARD,CH)
          UNTIL CH IN ['N','n','W','w','B','b','L','l','R','r'];
          CASE CH OF
          'N','n':
            BEGIN
              REPEAT
                WRITE('HOW MANY CLASSES? ');
                NUMB_OF_CLASSES:=ROUND(INPUT_VALUE);
                IF NOT(NUMB_OF_CLASSES IN [1..22]) THEN
                  WRITELN('ONLY VALUES BETWEEN 1 AND 22 MAY BE ENTERED. ')
              UNTIL NUMB_OF_CLASSES IN [1..22];
              WRITE('SHOULD I RECOMPUTE THE CLASS LIMITS? ');
              REPEAT READ(KEYBOARD,CH) UNTIL CH IN ['Y','y','N','n'];
              IF CH IN ['Y','y'] THEN COMPUTE_CLASS_WIDTH;
              CH:=' '
            END;
          'W','w':
            BEGIN
              WRITE('CLASS WIDTH = ');
              CLASS_WIDTH:=INPUT_VALUE
            END;
          'B','b':
            BEGIN
              WRITE('LEFT BOUNDRY VALUE = ');
              LEFT_START:=INPUT_VALUE
            END;
          'L','l':IF LEFT_END=OPEN THEN LEFT_END:=CLOSED ELSE LEFT_END:=OPEN;
          'R','r':IF RIGHT_END=OPEN THEN RIGHT_END:=CLOSED ELSE RIGHT_END:=OPEN
          END; {OF CASE}
          WRITE_OUTPUT
        END;
    UNTIL CH IN ['N','n'];
  END; {ASK_ABOUT_CHANGES}

BEGIN {SET_UP_CLASSES}
  LEFT_END:=CLOSED;
  RIGHT_END:=CLOSED;
  NUMB_OF_CLASSES:=ROUND(SQRT(DATA^.NUMBER_OF_POINTS));
  IF NUMB_OF_CLASSES<5 THEN NUMB_OF_CLASSES:=5
  ELSE IF NUMB_OF_CLASSES>15 THEN NUMB_OF_CLASSES:=15;
  COMPUTE_CLASS_WIDTH;
  WRITE_OUTPUT;
  ASK_ABOUT_CHANGES
END; {SET_UP_CLASSES}

PROCEDURE SCAN_FOR_LIMITS;
VAR I:INTEGER;
BEGIN {SCAN_FOR_LIMITS}
  WITH DATA^ DO
    BEGIN
      MIN:=DATA_POINT[1];
      MAX:=MIN;
      FOR I:=2 TO NUMBER_OF_POINTS DO
        IF DATA_POINT[I]<MIN THEN MIN:=DATA_POINT[I]
        ELSE IF DATA_POINT[I]>MAX THEN MAX:=DATA_POINT[I]
    END
END; {SCAN_FOR_LIMITS}

PROCEDURE GET_DATA;
VAR FLAG:BOOLEAN;
    CH:CHAR;
BEGIN {GET_DATA}
  FLAG:=FALSE;
  IF NOT STARTED THEN
    BEGIN
      STARTED:=TRUE;
{$I-}{TURN OFF I/O CHECKING}
      RESET(DATA,'HISTOGRAM.DATA');
      FLAG:=IORESULT<>0;
{$I+}{TURN ON I/O CHECKING}
      OLD_DATA_AVAILABLE:=NOT FLAG
    END;
  IF FLAG THEN REWRITE(DATA,'HISTOGRAM.DATA')
  ELSE
    BEGIN
      WRITE('DO YOU WANT TO USE');
      IF OLD_DATA_AVAILABLE THEN
        BEGIN
          WRITE(' THE D(iskfile DATA');
          IF NEW_DATA_USED THEN WRITE(',')
        END;
      IF NEW_DATA_USED THEN WRITE(' THE E(ntered DATA');
      WRITE(' OR N(ew DATA? ');
      REPEAT
        READ(KEYBOARD,CH);
        IF OLD_DATA_AVAILABLE AND (CH IN ['D','d']) THEN
          BEGIN
            NEW_DATA_USED:=FALSE;
            SEEK(DATA,0);
            GET(DATA);
            CH:=CHR(128)
          END;
        IF NEW_DATA_USED AND (CH IN ['E','e']) THEN CH:=CHR(128);
        IF CH IN ['N','n'] THEN
          BEGIN
            FLAG:=TRUE;
            CH:=CHR(128)
          END
      UNTIL CH=CHR(128)
    END;
  CLEARSCREEN;
  IF FLAG THEN
    WITH DATA^ DO
      BEGIN
        NEW_DATA_USED:=TRUE;
        NUMBER_OF_POINTS:=0;
        WRITELN('ENTER the DATA as requested');
        WRITELN;
        WRITELN('press ETX in place of RETURN after the LAST entry is made');
        WRITELN;
        WHILE (NUMBER_OF_POINTS<>255) AND NOT EOF DO
          BEGIN
            NUMBER_OF_POINTS:=NUMBER_OF_POINTS+1;
            WRITE('POINT ',NUMBER_OF_POINTS,' = ');
            DATA_POINT[NUMBER_OF_POINTS]:=INPUT_VALUE
          END;
        IF EOF THEN
          BEGIN
            RESET(INPUT);
            IF DATA_POINT[NUMBER_OF_POINTS]=0 THEN
              BEGIN
                WRITELN;
                WRITE('DID YOU INTEND FOR THE LAST POINT TO BE ZERO? ');
                REPEAT READ(KEYBOARD,CH) UNTIL CH IN ['Y','y','N','n'];
                IF CH IN ['N','n'] THEN NUMBER_OF_POINTS:=NUMBER_OF_POINTS-1;
                CH:=CHR(128)
              END
          END
        ELSE
          BEGIN
            WRITE('255 POINTS IS THE MAXIMUM');
            THROTTLE(180)
          END
      END
END; {GET_DATA}

PROCEDURE INITIALIZE;
BEGIN {INITIALIZE}
  CLEARSCREEN;
  STARTED:=FALSE;
  NEW_DATA_USED:=FALSE
END; {INITIALIZE}

BEGIN {HISTOGRAM}
  INITIALIZE;
  REPEAT
    GET_DATA;
    SCAN_FOR_LIMITS;
    SET_UP_CLASSES;
    SCAN_AND_ASSIGN_TO_CLASSES;
    WRITE_FREQUENCY_DISTRIBUTION;
    DRAW_HISTOGRAM;
    WRITE('IS THAT THE LAST HISTOGRAM? ');
    REPEAT READ(KEYBOARD,CH) UNTIL CH IN ['Y','y','N','n'];
    CLEARSCREEN
  UNTIL CH IN ['Y','y'];
  SEEK(DATA,0);
  IF NOT OLD_DATA_AVAILABLE THEN PUT(DATA)
  ELSE
    IF NEW_DATA_USED THEN
      BEGIN
        WRITELN('DO YOU WANT THE NEW DATA SAVED');
        WRITE('IN PLACE OF THE OLD ON THE DISK? ');
        REPEAT READ(KEYBOARD,CH) UNTIL CH IN ['Y','y','N','n'];
        IF CH IN ['Y','y'] THEN PUT(DATA)
      END;
  CLOSE(DATA,LOCK)
END {HISTOGRAM}.
